home *** CD-ROM | disk | FTP | other *** search
/ Software 2000 / Software 2000 Volume 1 (Disc 2 of 2).iso / demos / d008.dms / in.adf / Sample_Bank_MakerV2.AMOS / Sample_Bank_MakerV2.amosSourceCode
Encoding:
AMOS Source Code  |  1991-02-11  |  8.6 KB  |  336 lines
  1. '                            AMOS Sample Bank Maker.V2 
  2. '
  3. '                      Original routine by Francois Lionet     
  4. '                         AMOS version by P.J.Hickman  
  5. '                         IFF Routine by Gary Fearn   (8/9/90) 
  6. '
  7. '                       ï¿½ Copyright 1990 Mandarin Software 
  8. '
  9. '** UPDATE --- This program can now load standard 8SVX IFF samples.
  10. '
  11. ' You may increase the storage capacity of this program by changing
  12. ' the size of the text buffer
  13. Set Buffer 100
  14. Default 
  15. Close Editor 
  16. Dim S$(20),F$(20),F(20),TYPE(20)
  17. Dim LINE$(5),BUTTON$(3)
  18. NSAM=0 : L0ADED_SAMPLES=False
  19. Global S$(),F$(),F(),LINE$(),BUTTON$(),NSAM,TYPE(),L0ADED_SAMPLES
  20. SET_UP_SCREEN
  21. On Menu Proc MENU_1,MENU_2
  22. Repeat 
  23.    On Menu On 
  24. Until False
  25. Procedure MAKE_AMOS_BANK
  26.    On Error Goto FATEL_ERROR1
  27.    Cls 
  28.    F$=Fsel$("*.*","Samples.Abk","Please pick a save name.....")
  29.    If F$<>""
  30.       Bell 
  31.       Centre At(,7)+Border$("Please wait while I convert the samples.....",1)
  32.       Print At(36,10);Border$("SAMPLE:    ",1)
  33.       TL=2 : TN=0
  34.       For N=1 To NSAM
  35.          If Len(S$(N))<>0
  36.             Inc TN
  37.             TL=TL+Len(S$(N))+4+14
  38.          End If 
  39.       Next 
  40.       Erase 10
  41.       Reserve As Work 10,TL+12+8
  42.       AD=Start(10)
  43.       A$="AmBk"
  44.       For X=1 To Len(A$)
  45.          Poke AD+X-1,Asc(Mid$(A$,X,1))
  46.       Next X
  47.       AD=AD+4
  48.       Doke AD,5
  49.       AD=AD+2
  50.       Doke AD,0
  51.       AD=AD+2
  52.       Loke AD,(TL+8) or $80000000
  53.       AD=AD+4
  54.       A$="Samples "
  55.       For X=1 To Len(A$)
  56.          Poke AD+X-1,Asc(Mid$(A$,X,1))
  57.       Next X
  58.       AD=AD+8
  59.       ACALC=AD
  60.       Doke AD,TN
  61.       AD=AD+2
  62.       AOFF=AD
  63.       APOKE=AOFF+TN*4
  64.       For N=1 To NSAM
  65.          If TYPE(N)=1
  66.             WEIGHTING=0
  67.          Else 
  68.             If TYPE(N)=3
  69.                WEIGHTING=0
  70.             Else 
  71.                WEIGHTING=-128
  72.             End If 
  73.          End If 
  74.          If S$(N)<>""
  75.             Print At(44,10);N;
  76.             Loke AOFF,APOKE-ACALC
  77.             AOFF=AOFF+4
  78.             A$=Left$(F$(N),8)
  79.             AD=APOKE
  80.             For X=1 To Len(A$)
  81.                Poke AD+X-1,Asc(Mid$(A$,X,1))
  82.             Next X
  83.             If TYPE(N)<>3
  84.                FREQ=F(N)*1000
  85.             Else 
  86.                FREQ=F(N)
  87.             End If 
  88.             Doke APOKE+8,FREQ
  89.             Loke APOKE+10,Len(S$(N))
  90.             APOKE=APOKE+14
  91.             A=Varptr(S$(N))
  92.             PP=Varptr(P)
  93.             For X=0 To Len(S$(N))-1
  94.                P=Peek(A+X)+WEIGHTING
  95.                Poke APOKE+X,Peek(PP+3)
  96.             Next X
  97.             APOKE=APOKE+Len(S$(N))
  98.             If Btst(0,APOKE)
  99.                Inc APOKE
  100.             End If 
  101.          End If 
  102.       Next N
  103.       Cls 
  104.       Bell 
  105.       If Right$(Upper$(F$),4)<>".ABK"
  106.          F$=F$+".Abk"
  107.       End If 
  108.       Centre At(,8)+Border$("Saving new sample bank.....",1)
  109.       Bsave F$,Start(10) To Start(10)+TL+12+8
  110.    End If 
  111.    RECOVER_1:
  112.    DISPLAY_SAMS
  113.    Pop Proc
  114.    FATEL_ERROR1:
  115.    For LOP=1 To 5
  116.       Bell 30-LOP
  117.       Wait 3
  118.    Next LOP
  119.    If Errn=26
  120.       Erase 10
  121.       LINE$(0)="I'm out of Memory!"
  122.    Else 
  123.       LINE$(0)="Woops, disc error!"
  124.    End If 
  125.    BUTTON$(0)="Never mind."
  126.    ALERT[21,7,0,1,1,1]
  127.    Resume RECOVER_1
  128. End Proc
  129. Procedure L0AD_SAMPLE
  130.    On Error Goto FATEL_ERROR2
  131.    Inc NSAM
  132.    F$(NSAM)=Fsel$("","","Please choose a sample to load")
  133.    If Not Exist(F$(NSAM))
  134.       For LOP=1 To 5
  135.          Bell 30-LOP
  136.          Wait 3
  137.       Next LOP
  138.       LINE$(0)="I cannot find that"
  139.       LINE$(1)="file on this disc!"
  140.       BUTTON$(0)="Woops......."
  141.       ALERT[21,7,0,1,1,2]
  142.       F$(NSAM)=""
  143.    Else 
  144.       Open In 1,F$(NSAM)
  145.       If Lof(1)<Free
  146.          S$(NSAM)=Input$(1,Lof(1)) : Rem          S$() contains the sample data 
  147.          Add MEM,-Lof(1) : Rem                    F() contains the frequency  
  148.          FILEN=Lof(1)
  149.          Close 
  150.          If Left$(S$(NSAM),3)="JON" : Rem         This checks for STOS Sample              
  151.             F(NSAM)=Peek(Varptr(S$(NSAM))+3)
  152.             S$(NSAM)=Mid$(S$(NSAM),4)
  153.             TYPE(NSAM)=2
  154.          End If 
  155.          If Left$(S$(NSAM),4)="FORM" : Rem       This checks for an IFF file
  156.             POS=Hunt(Varptr(S$(NSAM)) To Varptr(S$(NSAM))+FILEN/2,"VHDR")
  157.             If POS<>0
  158.                F(NSAM)=Deek(POS+20)
  159.                PIS=Hunt(POS To Varptr(S$(NSAM))+FILEN/2,"BODY")
  160.                LTEM=Leek(PIS+4) : Add PIS,8
  161.                S$=Mid$(S$,PIS-Varptr(S$),LTEM)
  162.                TYPE(NSAM)=3
  163.             End If 
  164.          End If 
  165.          If TYPE(NSAM)=0
  166.             Cls 
  167.             Bell 
  168.             Clear Key 
  169.             Centre At(,8)+Border$("This Sample is in Amiga RAW format.",1)
  170.             Input At(0,12)+"Please enter sampling frequency (KHz):";F(NSAM)
  171.             If F(NSAM)<1 or F(NSAM)>32
  172.                F(NSAM)=15
  173.             End If 
  174.             TYPE(NSAM)=1
  175.             Cls 
  176.          End If 
  177.          If(1 and Len(S$(NSAM)))
  178.             S$(NSAM)=S$(NSAM)+Right$(S$(NSAM),1)
  179.          End If 
  180.          F$(NSAM)=Right$(F$(NSAM),Len(F$(NSAM))-4)
  181.          DISPLAY_SAMS
  182.          L0ADED_SAMPLES=True
  183.       Else 
  184.          LINE$(0)="Sorry, you do not have enough free"
  185.          LINE$(1)="    memory to load this sample.   "
  186.          BUTTON$(0)="Memory expansion time"
  187.          ALERT[40,7,0,1,1,2]
  188.       End If 
  189.    End If 
  190.    RECOVER_2:
  191.    Close 
  192.    Pop Proc
  193.    FATEL_ERROR2:
  194.    If FILE$<>""
  195.       For LOP=1 To 5
  196.          Bell 30-LOP
  197.          Wait 3
  198.       Next LOP
  199.       LINE$(0)="Woops, disc error!"
  200.       BUTTON$(0)="Never mind."
  201.       ALERT[21,7,0,1,1,1]
  202.       Dec NSAM
  203.       FILE$=""
  204.    End If 
  205.    Resume RECOVER_2
  206. End Proc
  207. Procedure DISPLAY_SAMS
  208.    Cls 
  209.    Curs Off 
  210.    Inverse On 
  211.    Print At(0,0);"| Sample |       Sample name      |   Length   |  Frequency  |  Sample Type  |";
  212.    Inverse Off 
  213.    Under On 
  214.    For LOP=1 To NSAM
  215.       Print At(0,LOP);"|        |                        |            |             |               |";
  216.       Print At(3,LOP);LOP;At(11,LOP);Left$(F$(LOP),21);At(36,LOP); Using "#######";Len(S$(LOP))
  217.       Print At(52,LOP); Using "#####";F(LOP);"Khz"
  218.       If TYPE(LOP)=1
  219.          Print At(68,LOP);"RAW"; : End If 
  220.       If TYPE(LOP)=2
  221.          Print At(63,LOP);"STOS  MAESTRO"; : End If 
  222.       If TYPE(LOP)=3
  223.          Print At(63,LOP);"IFF"; : End If 
  224.       If Inkey$<>""
  225.          Wait Key 
  226.       End If 
  227.    Next LOP
  228.    Under Off 
  229.    Print 
  230.    Inverse On 
  231.    Centre "Free memory:"+Str$(Free)
  232.    Inverse Off 
  233. End Proc
  234. Procedure SET_UP_SCREEN
  235.    Screen Open 1,640,200,2,Hires
  236.    Colour 1,$FFF : Flash Off : Curs Off : Cls 0
  237.    Paper 0
  238.    Pen 1
  239.    Menu$(1)=" AMOS  "
  240.    Menu$(1,1)=" About "
  241.    Menu$(1,2)="=======" : Menu Inactive(1,2)
  242.    Menu$(1,3)=" Quit  "
  243.    Menu$(2)=" Edit "
  244.    Menu$(2,1)=" Load sample.      "
  245.    Menu$(2,2)="===================" : Menu Inactive(2,2)
  246.    Menu$(2,3)=" Save sample bank. "
  247.    Menu$(2,4)="===================" : Menu Inactive(2,4)
  248.    Menu$(2,5)=" Erase all samples."
  249.    DEF_SETTING
  250.    Reserve Zone 1
  251.    Menu On 
  252. End Proc
  253. Procedure DEF_SETTING
  254.    Cls 
  255.    For LOP=1 To NSAM
  256.       S$(LOP)=""
  257.       F$(LOP)=""
  258.       F(LOP)=0
  259.       TYPE(LOP)=0
  260.    Next LOP
  261.    L0ADED_SAMPLES=False
  262.    NSAM=0
  263.    Centre At(,7)+"AMOS SAMPLE BANK MAKER"
  264.    Centre At(,9)+"By P.J.Hickman"
  265.    Centre At(,10)+"IFF support by Gary Fearn"
  266.    Inverse On 
  267.    Centre At(,13)+"Free memory:"+Str$(Free)
  268.    Inverse Off 
  269.    Centre At(,16)+Border$("Click right mouse button to display menu",1)
  270.    Repeat : Until Mouse Click
  271. End Proc
  272. Procedure ALERT[W,H,BACK_COL,LINE_COL,NB,NL]
  273.    Menu Off 
  274.    TEMP=0
  275.    W=W*8
  276.    H=H*8
  277.    X=(Screen Width/2)-W/2
  278.    Y=4
  279.    Get Block 241,0,Y-2,Screen Width,H+6
  280.    Ink BACK_COL
  281.    Bar X,Y-2 To X+W,Y+H
  282.    Ink LINE_COL
  283.    Box X+1,Y-2 To X+W-1,Y+H-1
  284.    S=W/8/(NB+1)+1
  285.    Paper BACK_COL
  286.    Pen LINE_COL
  287.    For LOP=0 To NL
  288.       Locate 0,Y Text(Y)+1+LOP
  289.       Centre LINE$(LOP)
  290.    Next LOP
  291.    TEMP=0
  292.    While TEMP<>NB
  293.       Locate X Text(X)+S/2+S*TEMP,Y Text(Y+H)-2
  294.       Print Border$(Zone$(BUTTON$(TEMP),TEMP+1),2);
  295.       Inc TEMP
  296.    Wend 
  297.    TEMP=0
  298.    Repeat 
  299.       Repeat : Until Mouse Click and Mouse Key=1
  300.       TEMP=Mouse Zone
  301.    Until TEMP>0
  302.    Put Block 241,0,Y-2
  303.    Del Block 241
  304.    Add TEMP,-96
  305.    For LOP=0 To NB
  306.       BUTTON$(LOP)=""
  307.    Next LOP
  308.    For LOP=0 To NL
  309.       LINE$(LOP)=""
  310.    Next LOP
  311.    Menu On 
  312. End Proc[TEMP]
  313. Procedure MENU_1
  314.    Shared LINE$(),BUTTON$()
  315.    If Choice(2)=1
  316.       For LOP=1 To 10
  317.          Bell 50+LOP
  318.          Wait 3
  319.       Next LOP
  320.       LINE$(0)="Sample Bank Maker"
  321.       LINE$(1)="~~~~~~~~~~~~~~~~~"
  322.       LINE$(2)=""
  323.       LINE$(3)=" By P.J.Hickman"
  324.       BUTTON$(0)="Have Fun!!!"
  325.       ALERT[22,9,0,1,1,4]
  326.    End If 
  327.    If Choice(2)=3
  328.       Default 
  329.       End 
  330.    End If 
  331. End Proc
  332. Procedure MENU_2
  333.    If Choice(2)=1 Then L0AD_SAMPLE
  334.    If L0ADED_SAMPLES and Choice(2)=3 Then MAKE_AMOS_BANK
  335.    If Choice(2)=5 Then DEF_SETTING
  336. End Proc